home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / lang / p_image1.sit / LSP Source / Utilities.p < prev   
Encoding:
Text File  |  1989-07-29  |  62.2 KB  |  2,782 lines
  1. unit Utilities;
  2.  
  3. {Miscellaneous utility routines used by Image program}
  4.  
  5. interface
  6.  
  7.     uses
  8.         QuickDraw, ToolIntf, OSIntf, PickerIntf, PrintTraps, globals, PaletteMgr;{SANE}
  9.  
  10.  
  11.  
  12.  
  13.     procedure SetDialogItem (TheDialog: DialogPtr; item, value: integer);
  14.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  15.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  16.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  17.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  18.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  19.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  20.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  21.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  22.     function StringToReal (str: str255): extended;
  23.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  24.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  25.     procedure DrawReal (Val: extended; width, fwidth: integer);
  26.     procedure DrawLong (i: LongInt);
  27.     function GetInt (message: str255; default: integer): integer;
  28.     function OptionKeyDown: boolean;
  29.     function ShiftKeyDown: boolean;
  30.     function ControlKeyDown: boolean;
  31.     function CommandPeriod: boolean;
  32.     function SpaceBarDown: boolean;
  33.  
  34.     procedure SysResume;
  35.     procedure beep;
  36.     procedure PutMessage (s1, s2, s3: str255);
  37.     procedure UpdateTextMenu;
  38.     procedure RedrawCLUTWindow;
  39.     procedure Load256ColorCLUT;
  40.     function LoadCLUTResource (id: integer): boolean;
  41.     procedure UnprotectLUT;
  42.     procedure LoadLUT (table: MyCSpecArray);
  43.     procedure DrawThreshold;
  44.     procedure StartThresholding;
  45.     procedure StopThresholding;
  46.     procedure UpdateColors;
  47.     procedure LoadInputLookupTable (address: ptr);
  48.     procedure ResetQuickCapture;
  49.     procedure GetLookupTable (var table: LookupTable);
  50.     procedure wait (ticks: LongInt);
  51.     procedure SetGrayScaleLUT;
  52.     procedure CheckColorWidth;
  53.     procedure GetDefaultPalette;
  54.     procedure GetPaletteFromFile (fname: str255; vnum: integer);
  55.     procedure InitColor (fname: str255; vnum: integer);
  56.     function GetScrapCount: integer;
  57.     procedure SetForegroundColor (color: integer);
  58.     procedure SetBackgroundColor (color: integer);
  59.     procedure ScreenToOffscreen (var loc: point);
  60.     procedure OffscreenToScreen (var loc: point);
  61.     procedure OffScreenToScreenRect (var r: rect);
  62.     procedure DisplayText;
  63.     procedure UpdateScreen (MaskRect: rect);
  64.     function GetColorIndex: integer;
  65.     procedure RestoreRoi;
  66.     procedure Undo;
  67.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  68.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  69.     function GetFontSize (item: integer): integer;
  70.     function MyGetPixel (h, v: integer): integer;
  71.     procedure PutPixel (h, v, value: integer);
  72.     procedure GetLine (h, v, count: integer; var line: LineType);
  73.     procedure GetColumn (hstart, vstart, count: integer; var data: LineType);
  74.     procedure PutColumn (hstart, vstart, count: integer; var data: LineType);
  75.     procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType);
  76.     procedure PutLine (h, v, count: integer; var line: LineType);
  77.     procedure Show1Value (rvalue, CalibratedValue: extended);
  78.     procedure Show2Values (x, y: LongInt);
  79.     procedure Show2CalibratedValues (x, y: LongInt; ShowUncalibrated: boolean);
  80.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  81.     procedure Show3RealValues (X, Y: LongInt; Z: extended);
  82.     procedure PutChar (c: char);
  83.     procedure PutTab;
  84.     procedure PutString (str: str255);
  85.     procedure PutReal (n: extended; width, fwidth: integer);
  86.     procedure PutLong (n: LongInt; FieldWidth: integer);
  87.     procedure CopyResultsToBuffer;
  88.     function GetResultsType: ResultsType;
  89.     procedure ShowWatch;
  90.     procedure UpdatePicWindow;
  91.     procedure DoOperation (Operation: OpType);
  92.     procedure SaveRoi;
  93.     procedure KillRoi;
  94.     procedure Paste;
  95.     procedure ShowRoi;
  96.     procedure SetupUndo;
  97.     procedure SetupUndoFromClip;
  98.     procedure DrawLabels;
  99.     function NotRectangular: boolean;
  100.     function NotInBounds: boolean;
  101.     function NoSelection: boolean;
  102.     function NewPicWindow (name: str255; width, height: integer): boolean;
  103.     procedure MakeRegion;
  104.     procedure SelectAll (visible: boolean);
  105.     procedure EraseScreen;
  106.     procedure RestoreScreen;
  107.     procedure Unzoom;
  108.     function FindMedian (var a: SortArray): integer;
  109.     procedure Duplicate (SavingBlankField: boolean);
  110.     procedure InvertPic;
  111.     procedure DrawBString (str: string);
  112.     procedure DrawMyGrowIcon (w: WindowPtr);
  113.     procedure PutOutOfMemMsg;
  114.     function GetMemory (Size: LongInt): ptr;
  115.     procedure UpdateAnalysisMenu;
  116.     procedure UpdateWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  117.     procedure MakeNewWindow (name: str255);
  118.     procedure PutWarning;
  119.     procedure ScaleToFit;
  120.     procedure SetupRoiRect;
  121.     procedure ConvertPlotToText;
  122.     procedure ConvertHistoToText;
  123.     procedure GetForegroundColor (event: EventRecord);
  124.     procedure GetBackgroundColor (event: EventRecord);
  125.     procedure GenerateValues;
  126.     procedure KillOperation;
  127.     procedure PutRMessage (LineNumber: integer; str: str255; n: LongInt);
  128.  
  129.  
  130. implementation
  131.  
  132.  
  133.     type
  134.         KeyPtrType = ^KeyMap;
  135.  
  136.  
  137.  
  138.     procedure SetDialogItem;{(TheDialog:DialogPtr; item,value:integer)}
  139.         var
  140.             ItemType: integer;
  141.             ItemBox: rect;
  142.             ItemHdl: handle;
  143.     begin
  144.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  145.         SetCtlValue(ControlHandle(ItemHdl), value)
  146.     end;
  147.  
  148.  
  149.     procedure OutlineButton;{(theDialog: DialogPtr; itemNo, CornerRad: integer)}
  150. { Draws a border around a button. 16 is the normal}
  151. {  cornerRad for small buttons }
  152.         var
  153.             itemType: Integer;
  154.             itemBox: Rect;
  155.             itemHdl: Handle;
  156.             tempPort: GrafPtr;
  157.     begin
  158.         GetPort(tempPort);
  159.         SetPort(theDialog);
  160.         GetDItem(theDialog, itemNo, itemType, itemHdl, itemBox);
  161.         PenSize(3, 3);
  162.         InSetRect(itemBox, -4, -4);
  163.         FrameRoundRect(itemBox, cornerRad, cornerRad);
  164.         PenSize(1, 1);
  165.         SetPort(tempPort);
  166.     end;
  167.  
  168.  
  169.     function GetDNum;{(TheDialog:DialogPtr; item:integer):LongInt}
  170.         var
  171.             ItemType: integer;
  172.             ItemBox: rect;
  173.             ItemHdl: handle;
  174.             str: str255;
  175.             n: LongInt;
  176.     begin
  177.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  178.         GetIText(ItemHdl, str);
  179.         StringToNum(str, n);
  180.         GetDNum := n;
  181.     end;
  182.  
  183.  
  184.     function GetDString;{(TheDialog:DialogPtr; item:integer):str255}
  185.         var
  186.             ItemType: integer;
  187.             ItemBox: rect;
  188.             ItemHdl: handle;
  189.             str: str255;
  190.     begin
  191.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  192.         GetIText(ItemHdl, str);
  193.         GetDString := str;
  194.     end;
  195.  
  196.  
  197.     procedure SetDNum;{(TheDialog:DialogPtr; item:integer; n:LongInt)}
  198.         var
  199.             ItemType: integer;
  200.             ItemBox: rect;
  201.             ItemHdl: handle;
  202.             str: str255;
  203.     begin
  204.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  205.         NumToString(n, str);
  206.         SetIText(ItemHdl, str)
  207.     end;
  208.  
  209.  
  210.     procedure GetWindowRect;{(w:WindowPtr; VAR wrect:rect)}
  211.   {Returns global coordinates of specified window.}
  212.     begin
  213.         if BitAnd(CGrafPort(w^).portVersion, $C000) = $C000 then
  214.             with CGrafPort(w^).PortPixMap^^.bounds do begin {Color GrafPort}
  215.                     wrect.left := -left;
  216.                     wrect.top := -top;
  217.                 end
  218.         else
  219.             with w^.portBits.bounds do begin
  220.                     wrect.left := -left;
  221.                     wrect.top := -top;
  222.                 end;
  223.         with w^.PortRect do begin
  224.                 wrect.right := wrect.left + right;
  225.                 wrect.bottom := wrect.top + bottom;
  226.             end;
  227.     end;
  228.  
  229.  
  230.     procedure SetDReal;{(TheDialog:DialogPtr; item:integer; n:extended; fwidth:integer)}
  231.         var
  232.             ItemType: integer;
  233.             ItemBox: rect;
  234.             ItemHdl: handle;
  235.             str: str255;
  236.     begin
  237.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  238.         RealToString(n, 1, fwidth, str);
  239.         SetIText(ItemHdl, str)
  240.     end;
  241.  
  242.  
  243.     procedure SetDString;{(TheDialog:DialogPtr; item:integer; str:str255)}
  244.         var
  245.             ItemType: integer;
  246.             ItemBox: rect;
  247.             ItemHdl: handle;
  248.     begin
  249.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  250.         SetIText(ItemHdl, str)
  251.     end;
  252.  
  253.  
  254.     function StringToReal (str: str255): extended;
  255.         const
  256.             BadReal = 999999.999;
  257.         var
  258.             i, ndigits: integer;
  259.             c: char;
  260.             n, m: extended;
  261.             negative, LeftOfPoint: boolean;
  262.     begin
  263.         negative := false;
  264.         n := 0;
  265.         LeftOfPoint := true;
  266.         m := 0.1;
  267.         ndigits := 0;
  268.         for i := 1 to length(str) do begin
  269.                 c := str[i];
  270.                 if c = '-' then
  271.                     negative := true
  272.                 else if c = '.' then
  273.                     LeftOfPoint := false
  274.                 else if (c >= '0') and (c <= '9') then begin
  275.                         ndigits := ndigits + 1;
  276.                         if LeftOfPoint then
  277.                             n := n * 10.0 + ord(c) - ord('0')
  278.                         else begin
  279.                                 n := n + (ord(c) - ord('0')) * m;
  280.                                 m := m * 0.1;
  281.                             end;
  282.                     end;
  283.             end;
  284.         if ndigits = 0 then
  285.             n := BadReal
  286.         else if negative then
  287.             n := -n;
  288.         StringToReal := n;
  289.     end;
  290.  
  291.  
  292.     function GetDReal;{(TheDialog:DialogPtr; item:integer):extended}
  293.         var
  294.             ItemType: integer;
  295.             ItemBox: rect;
  296.             ItemHdl: handle;
  297.             str: str255;
  298.     begin
  299.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  300.         GetIText(ItemHdl, str);
  301.         GetdReal := StringToReal(str);
  302.     end;
  303.  
  304.  
  305.     procedure DrawLong;{(i:LongInt)}
  306.         var
  307.             str: str255;
  308.     begin
  309.         NumToString(i, str);
  310.         DrawString(str);
  311.     end;
  312.  
  313.  
  314.     procedure RealToString;{(Val:extended; width,fwidth:integer; var Str:Str255)}
  315.   {Does number to string conversion equivalent to write(val:width:fwidth).}
  316. {var}
  317. {form: DecForm;}
  318.     begin
  319.         str := StringOf(val : width : fwidth); {Use LSP StringOf function because SANE Num2Str bombs out under A/UX}
  320. {form.digits := fwidth;}
  321. {form.style := FixedDecimal;}
  322. {Num2Str(form, val, DecStr(str));}
  323. {while length(Str) < width do begin}
  324. {str := concat(' ', Str)}
  325. {end;}
  326.     end;
  327.  
  328.  
  329.     procedure DrawReal;{(Val:extended; width,fwidth:integer)}
  330.   {Displays a real(or integer) number at the current location in}
  331.   {a form equivalent to write(val:width:fwidth) }
  332.         var
  333.             str: str255;
  334.     begin
  335.         RealToString(val, width, fwidth, str);
  336.         DrawString(str);
  337.     end;
  338.  
  339.  
  340.     function GetInt;{(message:str255; default:integer):integer}
  341.         const
  342.             NumberID = 3;
  343.         var
  344.             mylog: DialogPtr;
  345.             item: integer;
  346.             temp: LongInt;
  347.     begin
  348.         ParamText(message, '', '', '');
  349.         mylog := GetNewDialog(3000, nil, pointer(-1));
  350.         SetDNum(MyLog, NumberID, default);
  351.         SelIText(MyLog, NumberID, 0, 32767);
  352.         OutlineButton(MyLog, ok, 16);
  353.         repeat
  354.             ModalDialog(nil, item);
  355.         until (item = ok) or (item = cancel);
  356.         if item = ok then begin
  357.                 temp := GetDNum(MyLog, NumberID);
  358.                 if (temp > -MaxInt) and (temp <= MaxInt) then
  359.                     GetInt := temp
  360.                 else begin
  361.                         SysBeep(1);
  362.                         temp := -MaxInt
  363.                     end;
  364.             end
  365.         else
  366.             GetInt := -MaxInt;
  367.         DisposDialog(mylog);
  368.     end;
  369.  
  370.  
  371.     function OptionKeyDown;{:boolean}
  372.         var
  373.             KeyPtr: KeyPtrType;
  374.             keys: array[0..3] of LongInt;
  375.     begin
  376.         KeyPtr := KeyPtrType(@keys);
  377.         GetKeys(KeyPtr^);
  378.         OptionKeyDown := (BAND(keys[1], 4)) <> 0;
  379.     end;
  380.  
  381.  
  382.     function ShiftKeyDown;{:boolean}
  383.         var
  384.             KeyPtr: KeyPtrType;
  385.             keys: array[0..3] of LongInt;
  386.     begin
  387.         KeyPtr := KeyPtrType(@keys);
  388.         GetKeys(KeyPtr^);
  389.         ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
  390.     end;
  391.  
  392.  
  393.     function ControlKeyDown;{:boolean}
  394.         type
  395.             KeyPtrType = ^KeyMap;
  396.         var
  397.             KeyPtr: KeyPtrType;
  398.             keys: array[0..3] of LongInt;
  399.     begin
  400.         KeyPtr := KeyPtrType(@keys);
  401.         GetKeys(KeyPtr^);
  402.         ControlKeyDown := (BAND(keys[1], 8)) <> 0;
  403.     end;
  404.  
  405.  
  406.     function CommandPeriod;{:boolean}
  407.         type
  408.             KeyPtrType = ^KeyMap;
  409.         var
  410.             KeyPtr: KeyPtrType;
  411.             keys: array[0..3] of LongInt;
  412.     begin
  413.         KeyPtr := KeyPtrType(@keys);
  414.         GetKeys(KeyPtr^);
  415.         CommandPeriod := (BAND(keys[1], $808000)) = $808000;
  416.     end;
  417.  
  418.  
  419.     function SpaceBarDown: boolean;
  420.         var
  421.             KeyPtr: KeyPtrType;
  422.             keys: array[0..3] of LongInt;
  423.     begin
  424.         KeyPtr := KeyPtrType(@keys);
  425.         GetKeys(KeyPtr^);
  426.         SpaceBarDown := (BAND(keys[1], 512)) <> 0;
  427.     end;
  428.  
  429.  
  430.     procedure DrawSItem; {(itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255)}
  431. {Draw a string item in a dialog box.}
  432.         var
  433.             r: rect;
  434.             itype: integer;
  435.             ignore: handle;
  436.     begin
  437.         getditem(d, itemnum, itype, ignore, r);
  438.         textfont(fontrqst);
  439.         textsize(sizerqst);
  440.         textbox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
  441.     end;
  442.  
  443.  
  444.     procedure SysResume;
  445.     begin
  446.         FlushEvents(EveryEvent, 0);
  447.         ExitToShell;
  448.     end;
  449.  
  450.  
  451.     procedure beep;
  452.     begin
  453.         SysBeep(1)
  454.     end;
  455.  
  456.  
  457.     procedure PutMessage;{(s1,s2,s3:str255)}
  458.         var
  459.             ignore: integer;
  460.     begin
  461.         InitCursor;
  462.         ParamText(s1, s2, s3, '');
  463.         Ignore := Alert(MessageID, nil);
  464.     end;
  465.  
  466.     function GetFontSize;{(item:integer):integer}
  467.     begin
  468.         case item of
  469.             1: 
  470.                 GetFontSize := 9;
  471.             2: 
  472.                 GetFontSize := 10;
  473.             3: 
  474.                 GetFontSize := 12;
  475.             4: 
  476.                 GetFontSize := 14;
  477.             5: 
  478.                 GetFontSize := 18;
  479.             6: 
  480.                 GetFontSize := 24;
  481.             7: 
  482.                 GetFontSize := 36;
  483.             8: 
  484.                 GetFontSize := 42;
  485.             9: 
  486.                 GetFontSize := 48;
  487.             10: 
  488.                 GetFontSize := 54;
  489.             11: 
  490.                 GetFontSize := 72;
  491.         end;
  492.     end;
  493.  
  494.  
  495.     procedure SetMenuItem; {(menuh:menuhandle; itemnum:integer; on:boolean)}
  496. {Enable or disable menuh's itemnum. }
  497.     begin
  498.         if on then
  499.             EnableItem(menuh, itemnum)
  500.         else
  501.             DisableItem(menuh, itemnum);
  502.         if ItemNum = 0 then
  503.             DrawMenuBar;
  504.     end;
  505.  
  506.  
  507.     procedure CheckOnOffItem;{(MenuH:MenuHandle; item,fst,lst:Integer)}
  508.         var
  509.             i: integer;
  510.     begin
  511.         for i := fst to lst do
  512.             if i = item then
  513.                 CheckItem(MenuH, i, true)
  514.             else
  515.                 CheckItem(MenuH, i, false);
  516.     end;
  517.  
  518.  
  519.     procedure UpdateTextMenu;
  520.         var
  521.             size, i, MenuItem, FontID, item: integer;
  522.             FontName: str255;
  523.             FontFound, FoundIt: boolean;
  524.     begin
  525.         FontFound := false;
  526.         for item := 1 to NumFontItems do begin
  527.                 GetItem(FontMenuH, Item, FontName);
  528.                 GetFNum(FontName, FontID);
  529.                 if FontID = CurrentFontID then begin
  530.                         FontFound := true;
  531.                         CheckItem(FontMenuH, Item, True)
  532.                     end
  533.                 else
  534.                     CheckItem(FontMenuH, Item, false);
  535.             end;
  536.         if not FontFound then begin
  537.                 FoundIt := False;
  538.                 Item := 1;
  539.                 repeat
  540.                     GetItem(FontMenuH, Item, FontName);
  541.                     GetFNum(FontName, FontID);
  542.                     if FontID = Geneva then begin
  543.                             CheckItem(FontMenuH, Item, True);
  544.                             CurrentFontID := FontID;
  545.                             FoundIt := true;
  546.                         end;
  547.                     Item := Item + 1;
  548.                 until (Item > NumFontItems) or FoundIt;
  549.             end;
  550.  
  551.         for i := 1 to 11 do begin
  552.                 size := GetFontSize(i);
  553.                 if RealFont(CurrentFontID, size) then
  554.                     SetItemStyle(SizeMenuH, i, [OutLine])
  555.                 else
  556.                     SetItemStyle(SizeMenuH, i, [])
  557.             end;
  558.  
  559.         for i := TxPlain to TxShadow do
  560.             CheckItem(StyleMenuH, i, false);
  561.         if CurrentStyle = [] then
  562.             CheckItem(StyleMenuH, TxPlain, true)
  563.         else begin
  564.                 if Bold in CurrentStyle then
  565.                     CheckItem(StyleMenuH, TxBold, true);
  566.                 if Italic in CurrentStyle then
  567.                     CheckItem(StyleMenuH, TxItalic, true);
  568.                 if Underline in CurrentStyle then
  569.                     CheckItem(StyleMenuH, TxUnderline, true);
  570.                 if Outline in CurrentStyle then
  571.                     CheckItem(StyleMenuH, TxOutline, true);
  572.                 if Shadow in CurrentStyle then
  573.                     CheckItem(StyleMenuH, Txshadow, true);
  574.             end;
  575.  
  576.         case CurrentSize of
  577.             9: 
  578.                 MenuItem := 1;
  579.             10: 
  580.                 MenuItem := 2;
  581.             12: 
  582.                 MenuItem := 3;
  583.             14: 
  584.                 MenuItem := 4;
  585.             18: 
  586.                 MenuItem := 5;
  587.             24: 
  588.                 MenuItem := 6;
  589.             36: 
  590.                 MenuItem := 7;
  591.             42: 
  592.                 MenuItem := 8;
  593.             48: 
  594.                 MenuItem := 9;
  595.             54: 
  596.                 MenuItem := 10;
  597.             72: 
  598.                 MenuItem := 11;
  599.         end;
  600.         CheckOnOffItem(SizeMenuH, MenuItem, 1, 11);
  601.  
  602.         case TextJust of
  603.             LeftJust: 
  604.                 MenuItem := LeftItem;
  605.             CenterJust: 
  606.                 MenuItem := CenterItem;
  607.             RightJust: 
  608.                 MenuItem := RightItem;
  609.         end;
  610.         CheckOnOffItem(TextMenuH, MenuItem, LeftItem, RightItem);
  611.  
  612.         if TextBack = NoBack then
  613.             MenuItem := NoBackgroundItem
  614.         else
  615.             MenuItem := WithBackgroundItem;
  616.         CheckOnOffItem(TextMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
  617.     end;
  618.  
  619.  
  620.     procedure LoadLUT (table: MyCSpecArray);
  621.         var
  622.             i, entry: integer;
  623.             cPtr: ^cSpecArray;
  624.     begin
  625.         if nExtraColors > 0 then begin
  626.                 entry := FirstExtraColorsEntry;
  627.                 for i := 1 to nExtraColors do begin
  628.                         table[entry].rgb := ExtraColors[i];
  629.                         entry := entry + 1;
  630.                     end;
  631.             end;
  632.         cPtr := @table[1];
  633.         for i := 1 to 254 do begin
  634.                 ProtectEntry(i, false);
  635.                 ReserveEntry(i, false);
  636.             end;
  637.         SetEntries(1, 253, cPtr^);
  638.     end;
  639.  
  640.  
  641.     procedure RedrawCLUTWindow;
  642.     begin
  643.         LoadLUT(info^.cTable);
  644.         cheight := 256 + (2 + nExtraColors) * ExtraColorsHeight;
  645.         SizeWindow(LUTWindow, cwidth, cheight, true);
  646.     end;
  647.  
  648.  
  649.     procedure Load256ColorCLUT;
  650.         const
  651.             Sat = -1;
  652.             Val = -1;
  653.         var
  654.             i: integer;
  655.             color: HSVColor;
  656.     begin
  657.         StopThresholding;
  658.         with info^ do begin
  659.                 for i := 0 to 255 do begin
  660.                         color.hue := i * 256;
  661.                         color.saturation := sat;
  662.                         color.value := val;
  663.                         HSV2RGB(color, ctable[i].rgb);
  664.                     end;
  665.                 LoadLUT(ctable);
  666.                 LUTMode := spectrum;
  667.             end;
  668.         IdentityFunction := false;
  669.     end;
  670.  
  671.  
  672.     function LoadCLUTResource;{(id:integer):boolean}
  673.         var
  674.             Size: LongInt;
  675.             h: cTabHandle;
  676.             MyColorTable: record
  677.                     ctSeed: LONGINT;
  678.                     transIndex: INTEGER;
  679.                     ctSize: INTEGER;
  680.                     ctTable: MyCSpecArray;
  681.                 end;
  682.     begin
  683.         StopThresholding;
  684.         h := GetCTable(id);
  685.         size := GetHandleSize(handle(h));
  686.         if (ResError <> NoErr) or (size <> 2056) then begin
  687.                 LoadCLUTResource := false;
  688.                 if h <> nil then
  689.                     DisposCTable(h);
  690.                 exit(LoadCLUTResource)
  691.             end;
  692.         BlockMove(handle(h)^, @MyColorTable, size);
  693.         DisposCTable(h);
  694.         LoadLUT(MyColorTable.ctTable);
  695.         with info^ do begin
  696.                 cTable := MyColorTable.ctTable;
  697.                 if id = AppleDefaultCLUT then
  698.                     LUTMode := AppleDefault
  699.                 else
  700.                     LUTMode := Custom;
  701.             end;
  702.         IdentityFunction := false;
  703.         LoadCLUTResource := true;
  704.     end;
  705.  
  706.  
  707.     procedure DrawThreshold;
  708.         var
  709.             i: integer;
  710.     begin
  711.         for i := 0 to 255 do
  712.             with info^ do
  713.                 if (i >= ThresholdStart) and (i <= ThresholdEnd) then
  714.                     cTable[i].rgb := ThresholdColor
  715.                 else
  716.                     ctable[i].rgb := SaveCTable^[i].rgb;
  717.         LoadLUT(info^.cTable);
  718.     end;
  719.  
  720.  
  721.     procedure StartThresholding;
  722.         var
  723.             tPort: GrafPtr;
  724.     begin
  725.         if not Thresholding then begin
  726.                 new(SaveCTable);
  727.                 if SaveCTable <> nil then begin
  728.                         SaveCTable^ := info^.ctable;
  729.                         DrawThreshold;
  730.                         Thresholding := true;
  731.                     end;
  732.                 if (CurrentTool <> LutTool) and (CurrentTool <> Wand) then begin
  733.                         GetPort(tPort);
  734.                         SetPort(ToolWindow);
  735.                         CurrentTool := LutTool;
  736.                         InvalRect(ToolRect[CurrentTool]);
  737.                         SetPort(tPort);
  738.                     end;
  739.             end;
  740.     end;
  741.  
  742.  
  743.     procedure StopThresholding;
  744.     begin
  745.         if Thresholding then begin
  746.                 Thresholding := false;
  747.                 with info^ do
  748.                     if lutMode = GrayScale then
  749.                         SetGrayScaleLUT
  750.                     else
  751.                         ctable := SaveCTable^;
  752.                 dispose(SaveCTable);
  753.                 LoadLUT(info^.cTable);
  754.             end;
  755.     end;
  756.  
  757.  
  758.     procedure UpdateColors;
  759.         var
  760.             MaxStart, LastColor, i: integer;
  761.             index: 0..MaxPseudoColorsLessOne;
  762.     begin
  763.         StopThresholding;
  764.         with info^ do begin
  765.                 LastColor := ColorStart + nColors * ColorWidth - 1;
  766.                 for i := 0 to 255 do
  767.                     with cTable[255 - i].rgb do begin
  768.                             if (i < ColorStart) or (i > LastColor) then begin
  769.                                     Red := 0;
  770.                                     Green := 0;
  771.                                     Blue := 0;
  772.                                 end
  773.                             else begin
  774.                                     index := (i - ColorStart) div ColorWidth;
  775.                                     if index < 0 then
  776.                                         index := 0;
  777.                                     if index > nColors - 1 then
  778.                                         index := nColors - 1;
  779.                                     Red := RedX[index];
  780.                                     Green := GreenX[index];
  781.                                     Blue := BlueX[index];
  782.                                 end;
  783.                         end; {for}
  784.                 LoadLUT(cTable);
  785.                 LUTMode := ColorPalette;
  786.             end;
  787.         IdentityFunction := false;
  788.     end;
  789.  
  790.  
  791.     procedure LoadInputLookupTable;{(address:ptr)}
  792.         type
  793.             ilutType = packed array[0..1023] of byte;
  794.             ilutPtr = ^ilutType;
  795.         var
  796.             ilut: ilutPtr;
  797.             i: integer;
  798.     begin
  799.         ilut := ilutPtr(address);
  800.         if InvertVideo then begin
  801.                 for i := 0 to 255 do
  802.                     ilut^[i * 4] := i;
  803.                 ilut^[0] := 1;
  804.                 ilut^[255 * 4] := 254
  805.             end
  806.         else begin
  807.                 for i := 0 to 255 do
  808.                     ilut^[i * 4] := 255 - i;
  809.                 ilut^[0] := 254;
  810.                 ilut^[255 * 4] := 1
  811.             end;
  812.     end;
  813.  
  814.  
  815.     procedure ResetQuickCapture;
  816.         const
  817.             ilutOffset = $90000;
  818.     begin
  819.         ControlReg^ := 1; {reset}
  820.         while ControlReg^ < 0 do
  821.             ;
  822.         ChannelReg^ := VideoChannel * 64;
  823.         while ControlReg^ < 0 do
  824.             ;
  825.         LoadInputLookupTable(Ptr(DTSlotBase + ilutOffset));
  826.     end;
  827.  
  828.  
  829.     procedure GetLookupTable;{(VAR table:LookupTable)}
  830.         var
  831.             i, r, g, b: integer;
  832.     begin
  833.         if Thresholding then begin
  834.                 for i := 0 to 255 do
  835.                     if (i >= ThresholdStart) and (i <= ThresholdEnd) then begin
  836.                             if ThresholdToForeground then
  837.                                 table[i] := ForegroundColor
  838.                             else
  839.                                 table[i] := i
  840.                         end
  841.                     else begin
  842.                             if NonThresholdToBackground then
  843.                                 table[i] := BackgroundColor
  844.                             else
  845.                                 table[i] := i
  846.                         end;
  847.                 StopThresholding;
  848.                 exit(GetLookupTable);
  849.             end;
  850.         with info^ do
  851.             if (LutMode = GrayScale) or (LutMode = CustomGrayscale) then
  852.                 for i := 0 to 255 do
  853.                     table[i] := 255 - BSR(cTable[i].RGB.red, 8)
  854.             else begin
  855.                     table[0] := 0;
  856.                     for i := 1 to 254 do
  857.                         with cTable[i].RGB do
  858.                             table[i] := 255 - trunc(band(bsr(red, 8), 255) * 0.3 + band(bsr(green, 8), 255) * 0.59 + band(bsr(blue, 8), 255) * 0.11);
  859.                     table[255] := 255;
  860.                 end;
  861.     end;
  862.  
  863.  
  864.     procedure wait;{(ticks:LongInt)}
  865.         var
  866.             SaveTicks: LongInt;
  867.     begin
  868.         SaveTicks := TickCount + ticks;
  869.         repeat
  870.         until TickCount > SaveTicks;
  871.     end;
  872.  
  873.  
  874.     procedure MakeLine (X1, Y1, X2, Y2: integer);
  875.         var
  876.             x: integer;
  877.             v, temp: integer;
  878.     begin
  879.         with info^ do begin
  880.                 if not gmFixedSlope then begin
  881.                         DeltaX := X2 - X1;
  882.                         DeltaY := y2 - y1;
  883.                     end;
  884.                 if Deltax <> 0 then
  885.                     for X := X1 to X2 do
  886.                         with info^.cTable[255 - x].rgb do begin
  887.                                 temp := (LongInt(DeltaY) * (x - x1)) div DeltaX + Y1; {Temporary variable needed to avoid range check}
  888.                                 v := temp * 256;
  889.                                 red := v;
  890.                                 green := v;
  891.                                 blue := v;
  892.                             end;
  893.             end;
  894.     end;
  895.  
  896.  
  897.     procedure MakeHorizontalLine (X1, X2, Y: integer);
  898.         var
  899.             x: integer;
  900.             v: integer;
  901.     begin
  902.         for X := X1 to X2 do
  903.             with info^.cTable[255 - x].rgb do begin
  904.                     v := y * 256;
  905.                     red := v;
  906.                     green := v;
  907.                     blue := v;
  908.                 end;
  909.     end;
  910.  
  911.  
  912.     procedure SetGrayScaleLUT;
  913.     begin
  914.         with info^ do begin
  915.                 MakeHorizontalLine(0, p1x, 0);
  916.                 MakeLine(p1x, p1y, p2x, p2y);
  917.                 MakeHorizontalLine(p2x, 255, 255);
  918.                 LoadLUT(cTable);
  919.                 LUTMode := GrayScale;
  920.             end;
  921.     end;
  922.  
  923.  
  924.     procedure CheckColorWidth;
  925.     begin
  926.         with info^ do
  927.             if (ColorStart + ncolors * ColorWidth) > 255 then begin
  928.                     ColorWidth := (255 - ColorStart) div ncolors;
  929.                     if ColorWidth < 1 then
  930.                         ColorWidth := 1;
  931.                 end;
  932.     end;
  933.  
  934.  
  935.     procedure GetPaletteFromFile;{(fname:str255; vnum:integer)}
  936.         var
  937.             PaletteHeader: ColorArray;
  938.             err, f: integer;
  939.             size: LongInt;
  940.     begin
  941.         err := FSOpen(fname, vnum, f);
  942.         with info^ do begin
  943.                 size := SizeOf(ColorArray);
  944.                 err := FSRead(f, size, @PaletteHeader);
  945.                 nColors := PaletteHeader[0];
  946.                 if nColors > MaxPseudocolors then
  947.                     nColors := MaxPseudoColors;
  948.                 ColorStart := PaletteHeader[1];
  949.                 ColorWidth := PaletteHeader[2];
  950.                 CheckColorWidth;
  951.                 with PaletteRec do begin
  952.                         err := FSRead(f, size, @RedData);
  953.                         err := FSRead(f, size, @GreenData);
  954.                         err := FSRead(f, size, @BlueData);
  955.                     end;
  956.             end;
  957.         err := fsclose(f);
  958.         PaletteName := fname;
  959.     end;
  960.  
  961.  
  962.     procedure GetDefaultPalette;
  963.         var
  964.             Size: LongInt;
  965.             pHandle: handle;
  966.             i: integer;
  967.     begin
  968.         with info^ do begin
  969.                 ncolors := 0;
  970.                 pHandle := GetResource('CPAL', 1000);
  971.                 if (ResError <> noErr) or (pHandle = nil) then begin
  972.                         beep;
  973.                         if pHandle <> nil then
  974.                             ReleaseResource(pHandle);
  975.                         exit(GetDefaultPalette)
  976.                     end;
  977.                 Size := GetHandleSize(pHandle);
  978.                 if size = SizeOF(PaletteRec) then begin
  979.                         BlockMove(pHandle^, @PaletteRec, size);
  980.                         ncolors := PaletteRec.NumberOfColors;
  981.                     end;
  982.                 for i := 0 to MaxPseudoColorsLessOne do
  983.                     with PaletteRec do begin
  984.                             RedX[i] := RedData[i] * 255;
  985.                             GreenX[i] := GreenData[i] * 255;
  986.                             BlueX[i] := BlueData[i] * 255;
  987.                         end;
  988.                 LUTMode := ColorPalette;
  989.             end;
  990.         ReleaseResource(pHandle);
  991.     end;
  992.  
  993.  
  994.     procedure InitColor;{(fname:str255; vnum:integer)}
  995.         var
  996.             i: integer;
  997.     begin
  998.         with info^ do begin
  999.                 if fname = 'Default' then
  1000.                     GetDefaultPalette
  1001.                 else begin
  1002.                         GetPaletteFromFile(fname, vnum);
  1003.                         LUTMode := ColorPalette;
  1004.                     end;
  1005.                 for i := 0 to ncolors - 1 do
  1006.                     with PaletteRec do begin
  1007.                             RedX[i] := RedData[i] * 255;
  1008.                             GreenX[i] := GreenData[i] * 255;
  1009.                             BlueX[i] := BlueData[i] * 255;
  1010.                         end;
  1011.             end;
  1012.     end;
  1013.  
  1014.  
  1015.     function GetScrapCount;{:integer}
  1016.         var
  1017.             ScrapInfo: PScrapStuff;
  1018.     begin
  1019.         ScrapInfo := InfoScrap;
  1020.         GetScrapCount := ScrapInfo^.ScrapCount;
  1021.     end;
  1022.  
  1023.  
  1024.     procedure SetForegroundColor;{(color:integer)}
  1025.         var
  1026.             tPort: GrafPtr;
  1027.     begin
  1028.         if (color >= 0) and (color <= 255) then begin
  1029.                 ForegroundColor := color;
  1030.                 with info^ do
  1031.                     if osPort <> nil then
  1032.                         osPort^.fgColor := ForegroundColor;
  1033.                 GetPort(tPort);
  1034.                 SetPort(ToolWindow);
  1035.                 InvalRect(ToolRect[brush]);
  1036.                 SetPort(tPort);
  1037.                 if isInsertionPoint then
  1038.                     DisplayText;
  1039.                 if info^.LUTMode = ColorPalette then
  1040.                     CurrentColorIndex := GetColorIndex;
  1041.             end;
  1042.     end;
  1043.  
  1044.  
  1045.     procedure SetBackgroundColor;{(color:integer)}
  1046.         var
  1047.             tPort: GrafPtr;
  1048.     begin
  1049.         if (color >= 0) and (color <= 255) then begin
  1050.                 BackgroundColor := color;
  1051.                 with info^ do
  1052.                     if osPort <> nil then
  1053.                         osPort^.bkColor := backgroundColor;
  1054.                 GetPort(tPort);
  1055.                 SetPort(ToolWindow);
  1056.                 InvalRect(ToolRect[eraser]);
  1057.                 SetPort(tPort);
  1058.                 if isInsertionPoint then
  1059.                     DisplayText;
  1060.             end;
  1061.     end;
  1062.  
  1063.  
  1064.     function GetColorIndex;{:integer}
  1065.         var
  1066.             CLUTIndex: LongInt;
  1067.     begin
  1068.         CLUTIndex := 255 - ForegroundColor;
  1069.         with info^ do
  1070.             if (CLUTIndex < ColorStart) or (CLUTIndex > (ColorStart + nColors * ColorWidth)) then begin
  1071.                     GetColorIndex := NoColor
  1072.                 end
  1073.             else
  1074.                 GetColorIndex := (CLUTIndex - ColorStart) div ColorWidth;
  1075.     end;
  1076.  
  1077.  
  1078.     procedure OffScreenToScreenRect;{(VAR r:rect)}
  1079.         var
  1080.             p1, p2: point;
  1081.     begin
  1082.         with r do begin
  1083.                 p1.h := left;
  1084.                 p1.v := top;
  1085.                 p2.h := right;
  1086.                 p2.v := bottom;
  1087.                 OffScreenToScreen(p1);
  1088.                 OffScreenToScreen(p2);
  1089.                 Pt2Rect(p1, p2, r);
  1090.             end;
  1091.     end;
  1092.  
  1093.  
  1094.     procedure ScreenToOffscreen;{(VAR loc:point)}
  1095.     begin
  1096.         with loc, Info^ do begin
  1097.                 h := SrcRect.left + trunc(h / magnification);
  1098.                 v := SrcRect.top + trunc(v / magnification);
  1099.             end;
  1100.     end;
  1101.  
  1102.  
  1103.     procedure OffscreenToScreen;{(VAR loc:point)}
  1104.     begin
  1105.         with loc, Info^ do begin
  1106.                 h := trunc((h - SrcRect.left) * magnification);
  1107.                 v := trunc((v - SrcRect.top) * magnification);
  1108.             end;
  1109.     end;
  1110.  
  1111.  
  1112.     procedure UpdateScreen;{(MaskRect:rect)}
  1113. {Refreshes the portion of the screen defined by}
  1114. {MaskRect. MaskRect is defined in screen coordinates.}
  1115.         var
  1116.             tPort: GrafPtr;
  1117.             imag: integer;
  1118.     begin
  1119.         with Info^ do
  1120.             if info <> NoInfo then begin
  1121.                     getPort(tPort);
  1122.                     SetPort(Info^.wptr);
  1123.                     imag := trunc(magnification);
  1124.                     InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
  1125.                     InsetRect(MaskRect, 0, 0);
  1126.                     RectRgn(MaskRgn, MaskRect);
  1127.                     hlock(handle(osPort^.portPixMap));
  1128.                     hlock(handle(CGrafPort(ThePort^).PortPixMap));
  1129.                     CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
  1130.                     hunlock(handle(osPort^.portPixMap));
  1131.                     hunlock(handle(CGrafPort(ThePort^).PortPixMap));
  1132.                     SetPort(tPort);
  1133.                 end;
  1134.     end;
  1135.  
  1136.  
  1137.     procedure DisplayText;
  1138.         var
  1139.             tPort: GrafPtr;
  1140.             i, hstart, width, ff: integer;
  1141.             MaskRect: rect;
  1142.             p1, p2: point;
  1143.     begin
  1144.         if (info = NoInfo) or (CurrentTool <> TextTool) or (not IsInsertionPoint) then
  1145.             exit(DisplayText);
  1146.         Undo;
  1147.         GetPort(tPort);
  1148.         SetPort(GrafPtr(Info^.osPort));
  1149.         TextFont(CurrentFontID);
  1150.         TextFace(CurrentStyle);
  1151.         TextSize(CurrentSize);
  1152.         if TextBack = NoBack then
  1153.             TextMode(SrcOr)
  1154.         else
  1155.             TextMode(SrcCopy);
  1156.         width := StringWidth(TextStr);
  1157.         case TextJust of
  1158.             LeftJust: 
  1159.                 hstart := TextStart.h;
  1160.             CenterJust: 
  1161.                 hstart := TextStart.h - width div 2;
  1162.             RightJust: 
  1163.                 hstart := TextStart.h - width;
  1164.         end;
  1165.         if hstart < 0 then
  1166.             hstart := 0;
  1167.         MoveTo(hstart, TextStart.v);
  1168.         DrawString(TextStr);
  1169.         GetPen(InsertionPoint);
  1170.         ff := CurrentSize * 2;
  1171.         p1.h := hstart - ff;
  1172.         p1.v := TextStart.v - CurrentSize;
  1173.         p2.h := TextStart.h + width + ff;
  1174.         p2.v := TextStart.v + CurrentSize div 3;
  1175.         OffscreenToScreen(p1);
  1176.         OffscreenToScreen(p2);
  1177.         Pt2Rect(p1, p2, MaskRect);
  1178.         UpdateScreen(MaskRect);
  1179.         SetPort(tPort);
  1180.         Info^.changes := true;
  1181.     end;
  1182.  
  1183.  
  1184.     procedure RestoreRoi;
  1185.     begin
  1186.         with Info^ do begin
  1187.                 if info^.RoiShowing then begin
  1188.                         if OpPending then begin
  1189.                                 OpPending := false;
  1190.                                 DoOperation(CurrentOp);
  1191.                             end;
  1192.                         UpdateScreen(RoiRect)
  1193.                     end;
  1194.                 roiType := NoInfo^.roiType;
  1195.                 osRoiRect := NoInfo^.osRoiRect;
  1196.                 roiRect := osRoiRect;
  1197.                 OffscreenToScreenRect(roiRect);
  1198.                 CopyRgn(NoInfo^.osRoiRgn, osRoiRgn);
  1199.                 RoiShowing := true;
  1200.                 measuring := false;
  1201.                 RedoSelection := false;
  1202.                 WhatToUndo := NothingToUndo;
  1203.             end;
  1204.     end;
  1205.  
  1206.  
  1207.     procedure Undo;
  1208.         var
  1209.             SrcPtr, src, dst: ptr;
  1210.             line: integer;
  1211.     begin
  1212.         if info^.PicSize <> CurrentUndoSize then
  1213.             exit(Undo);
  1214.         if UndoFromClip then begin
  1215.                 if info^.PicSize > ClipBufSize then
  1216.                     exit(Undo);
  1217.                 SrcPtr := ClipBuf;
  1218.             end
  1219.         else
  1220.             SrcPtr := UndoBuf;
  1221.         with info^ do
  1222.             if PictureType = camera then begin
  1223.                     src := SrcPtr;
  1224.                     dst := PicBaseAddr;
  1225.                     for line := 1 to 480 do begin
  1226.                             BlockMove(src, dst, 640);
  1227.                             src := ptr(ord4(src) + 640);
  1228.                             dst := ptr(ord4(dst) + 1024);
  1229.                         end
  1230.                 end
  1231.             else
  1232.                 BlockMove(SrcPtr, PicBaseAddr, PicSize);
  1233.         if UndoFromClip and RestoreUndoBuf then
  1234.             with info^ do
  1235.                 BlockMove(SrcPtr, UndoBuf, PicSize);
  1236.         if RedoSelection then
  1237.             RestoreRoi;
  1238.     end;
  1239.  
  1240.  
  1241.     function MyGetPixel;{(h,v:integer):integer}
  1242.         var
  1243.             offset: LongInt;
  1244.             p: ptr;
  1245.     begin
  1246.         with Info^ do begin
  1247.                 if (h < 0) or (v < 0) or (h >= PixelsPerLine) or (v >= nlines) then begin
  1248.                         MyGetPixel := WhiteC;
  1249.                         exit(MyGetPixel);
  1250.                     end;
  1251.                 offset := LongInt(v) * BytesPerRow + h;
  1252.                 if offset >= PixMapSize then
  1253.                     exit(MyGetPixel);
  1254.                 p := ptr(ord4(PicBaseAddr) + offset);
  1255.                 MyGetPixel := BAND(p^, 255);
  1256.             end;
  1257.     end;
  1258.  
  1259.  
  1260.     procedure PutPixel;{(h,v,value:integer)}
  1261.         type
  1262.             uptr = ^UnsignedByte;
  1263.         var
  1264.             offset: LongInt;
  1265.             p: ptr;
  1266.     begin
  1267.         with Info^ do begin
  1268.                 if (h < 0) or (v < 0) or (h >= PixelsPerLine) or (v >= nlines) then
  1269.                     exit(PutPixel);
  1270.                 offset := LongInt(v) * BytesPerRow + h;
  1271.                 p := ptr(ord4(PicBaseAddr) + offset);
  1272.                 p^ := BAND(value, 255);
  1273.             end;
  1274.     end;
  1275.  
  1276.  
  1277.     procedure GetLine;{(h,v,count:integer; VAR line:LineType)}
  1278.         var
  1279.             offset: LongInt;
  1280.             p: ptr;
  1281.     begin
  1282.         with Info^ do begin
  1283.                 if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
  1284.                         line := BlankLine;
  1285.                         exit(GetLine);
  1286.                     end;
  1287.                 offset := LongInt(v) * BytesPerRow + h;
  1288.                 p := ptr(ord4(PicBaseAddr) + offset);
  1289.                 BlockMove(p, @line, count);
  1290.             end;
  1291.     end;
  1292.  
  1293.  
  1294.     procedure GetColumn;{(hstart,vstart,count:integer; VAR data:LineType)}
  1295.         var
  1296.             i, v: integer;
  1297.     begin
  1298.         v := vstart;
  1299.         for i := 0 to count - 1 do begin
  1300.                 data[i] := MyGetPixel(hstart, v);
  1301.                 v := v + 1;
  1302.             end;
  1303.     end;
  1304.  
  1305.  
  1306.     procedure PutColumn;{(hstart,vstart,count:integer; VAR data:LineType)}
  1307.         var
  1308.             i, v: integer;
  1309.     begin
  1310.         v := vstart;
  1311.         for i := 0 to count - 1 do begin
  1312.                 PutPixel(hstart, v, data[i]);
  1313.                 v := v + 1;
  1314.             end;
  1315.     end;
  1316.  
  1317.  
  1318.     procedure GetDiagLine;{(start,finish:Point; VAR count:integer; VAR data:LineType)}
  1319.         var
  1320.             sum: LongInt;
  1321.             p: ptr;
  1322.             deltax, deltay, xinc, yinc, accumulator, i: integer;
  1323.             xloc, yloc, offset, j: integer;
  1324.             average: boolean;
  1325.             buf: LineType;
  1326.     begin
  1327.         average := LineWidth > 1;
  1328.         offset := LineWidth div 2;
  1329.         count := 0;
  1330.         xloc := start.h;
  1331.         yloc := start.v;
  1332.         deltax := finish.h - xloc;
  1333.         deltay := finish.v - yloc;
  1334.         if (deltax = 0) and (deltay = 0) then begin
  1335.                 data[count] := MyGetPixel(xloc, yloc);
  1336.                 count := count + 1;
  1337.                 exit(GetDiagLine);
  1338.             end;
  1339.         if deltax < 0 then begin
  1340.                 xinc := -1;
  1341.                 deltax := -deltax
  1342.             end
  1343.         else
  1344.             xinc := 1;
  1345.         if deltay < 0 then begin
  1346.                 yinc := -1;
  1347.                 deltay := -deltay
  1348.             end
  1349.         else
  1350.             yinc := 1;
  1351.         if DeltaX > DeltaY then begin {More horizontal}
  1352.                 accumulator := deltax div 2;
  1353.                 i := deltax;
  1354.                 repeat
  1355.                     accumulator := accumulator + deltay;
  1356.                     if accumulator >= deltax then begin
  1357.                             accumulator := accumulator - deltax;
  1358.                             yloc := yloc + yinc
  1359.                         end;
  1360.                     xloc := xloc + xinc;
  1361.                     if average then begin
  1362.                             GetColumn(xloc, yloc - offset, LineWidth, buf);
  1363.                             sum := 0;
  1364.                             for j := 0 to LineWidth - 1 do
  1365.                                 sum := sum + buf[j];
  1366.                             data[count] := round(sum / LineWidth);
  1367.                         end
  1368.                     else
  1369.                         data[count] := MyGetPixel(xloc, yloc);
  1370.                     count := count + 1;
  1371.                     i := i - 1;
  1372.                 until i = 0
  1373.             end
  1374.         else begin          {More vertical}
  1375.                 accumulator := deltay div 2;
  1376.                 i := deltay;
  1377.                 repeat
  1378.                     accumulator := accumulator + deltax;
  1379.                     if accumulator >= deltay then begin
  1380.                             accumulator := accumulator - deltay;
  1381.                             xloc := xloc + xinc
  1382.                         end;
  1383.                     yloc := yloc + yinc;
  1384.                     if average then begin
  1385.                             GetLine(xloc - offset, yloc, LineWidth, buf);
  1386.                             sum := 0;
  1387.                             for j := 0 to LineWidth - 1 do
  1388.                                 sum := sum + buf[j];
  1389.                             data[count] := round(sum / LineWidth);
  1390.                         end
  1391.                     else
  1392.                         data[count] := MyGetPixel(xloc, yloc);
  1393.                     count := count + 1;
  1394.                     i := i - 1;
  1395.                 until i = 0
  1396.             end;
  1397.         count := count - 1;
  1398.     end;
  1399.  
  1400.  
  1401.     procedure PutLine;{(h,v,count:integer; VAR line:LineType)}
  1402.         var
  1403.             offset: LongInt;
  1404.             p: ptr;
  1405.     begin
  1406.         with Info^ do begin
  1407.                 if (h < 0) or (v < 0) or (v >= nlines) then
  1408.                     exit(PutLine);
  1409.                 if (h + count) > PixelsPerLine then
  1410.                     count := PixelsPerLine - h;
  1411.                 offset := LongInt(v) * BytesPerRow + h;
  1412.                 p := ptr(ord4(PicBaseAddr) + offset);
  1413.                 BlocKMove(@line, p, count);
  1414.             end;
  1415.     end;
  1416.  
  1417.  
  1418.     procedure PutRMessage (LineNumber: integer; str: str255; n: LongInt);
  1419.         const
  1420.             hstart = 4;
  1421.             vstart = 50;
  1422.         var
  1423.             tPort: GrafPtr;
  1424.             vloc: integer;
  1425.             tRect: rect;
  1426.     begin
  1427.         if ResultsWindow = nil then
  1428.             exit(PutRMessage);
  1429.         GetPort(tPort);
  1430.         SetPort(ResultsWindow);
  1431.         TextFont(ApplFont);
  1432.         TextSize(9);
  1433.         Setrect(trect, 0, 35, rwidth, rheight);
  1434.         if LineNumber = 1 then
  1435.             EraseRect(trect);
  1436.         vloc := vstart + 12 * (LineNumber - 1);
  1437.         MoveTo(hstart, vloc);
  1438.         DrawString(str);
  1439.         if n <> MaxInt then
  1440.             DrawLong(n);
  1441.         SetPort(tPort);
  1442.     end;
  1443.  
  1444.  
  1445.     procedure Show1Value (rvalue, CalibratedValue: extended);
  1446.         var
  1447.             tPort: GrafPtr;
  1448.             hstart, vstart, ivalue: integer;
  1449.     begin
  1450.         hstart := ValuesHStart;
  1451.         vstart := ValuesVStart;
  1452.         GetPort(tPort);
  1453.         SetPort(ResultsWindow);
  1454.         TextSize(9);
  1455.         TextFont(Monaco);
  1456.         TextMode(SrcCopy);
  1457.         MoveTo(xValueLoc, vstart);
  1458.         if CalibratedValue <> NoValue then begin
  1459.                 DrawReal(CalibratedValue, 5, 2);
  1460.                 DrawString(' (');
  1461.                 DrawReal(rvalue, 3, 0);
  1462.                 DrawString(')');
  1463.             end
  1464.         else
  1465.             DrawReal(rvalue, 6, 2);
  1466.         DrawString('    ');
  1467.         SetPort(tPort);
  1468.     end;
  1469.  
  1470.  
  1471.     procedure Show2Values;{(x,y:LongInt)}
  1472.         var
  1473.             tPort: GrafPtr;
  1474.             hstart, vstart, ivalue: integer;
  1475.     begin
  1476.         hstart := ValuesHStart;
  1477.         vstart := ValuesVStart;
  1478.         GetPort(tPort);
  1479.         SetPort(ResultsWindow);
  1480.         TextSize(9);
  1481.         TextFont(Monaco);
  1482.         TextMode(SrcCopy);
  1483.         MoveTo(xValueLoc, vstart);
  1484.         DrawLong(abs(x));
  1485.         DrawString('     ');
  1486.         MoveTo(yValueLoc, vstart + 10);
  1487.         DrawLong(abs(y));
  1488.         DrawString('     ');
  1489.         SetPort(tPort);
  1490.     end;
  1491.  
  1492.  
  1493.     procedure Show2CalibratedValues; {(x, y: LongInt; ShowUncalibrated: boolean)}
  1494.         var
  1495.             tPort: GrafPtr;
  1496.             hstart, vstart, ivalue: integer;
  1497.     begin
  1498.         hstart := ValuesHStart;
  1499.         vstart := ValuesVStart;
  1500.         GetPort(tPort);
  1501.         SetPort(ResultsWindow);
  1502.         TextSize(9);
  1503.         TextFont(Monaco);
  1504.         TextMode(SrcCopy);
  1505.         MoveTo(xValueLoc, vstart);
  1506.         DrawLong(x);
  1507.         DrawString('     ');
  1508.         MoveTo(yValueLoc, vstart + 10);
  1509.         if info^.Calibrated then begin
  1510.                 DrawReal(value[y], 5, 2);
  1511.                 if ShowUncalibrated then begin
  1512.                         DrawString(' (');
  1513.                         DrawLong(y);
  1514.                         DrawString(')');
  1515.                     end;
  1516.             end
  1517.         else
  1518.             DrawLong(y);
  1519.         DrawString('     ');
  1520.         SetPort(tPort);
  1521.     end;
  1522.  
  1523.  
  1524.     procedure Show3Values;{(hloc,vloc,ivalue:LongInt)}
  1525.         var
  1526.             tPort: GrafPtr;
  1527.             hstart, vstart: integer;
  1528.             CalibratedForLength: boolean;
  1529.     begin
  1530.         with info^ do begin
  1531.                 hstart := ValuesHStart;
  1532.                 vstart := ValuesVStart;
  1533.                 GetPort(tPort);
  1534.                 SetPort(ResultsWindow);
  1535.                 TextSize(9);
  1536.                 TextFont(Monaco);
  1537.                 TextMode(SrcCopy);
  1538.                 if hloc < 0 then
  1539.                     hloc := -hloc;
  1540.                 CalibratedForLength := scale <> 0.0;
  1541.                 MoveTo(xValueLoc, vstart);
  1542.                 if CalibratedForLength then begin
  1543.                         DrawReal(hloc / scale, 5, 2);
  1544.                         DrawString(units);
  1545.                         DrawString(' (');
  1546.                         DrawReal(hloc, 3, 0);
  1547.                         DrawString(')')
  1548.                     end
  1549.                 else
  1550.                     DrawLong(hloc);
  1551.                 DrawString('    ');
  1552.                 vloc := PicRect.bottom - vloc - 1;
  1553.                 if vloc < 0 then
  1554.                     vloc := -vloc;
  1555. {CursorXLoc := hloc;}
  1556. {CursorYLoc := vloc;}
  1557.                 MoveTo(yValueLoc, vstart + 10);
  1558.                 if CalibratedForLength then begin
  1559.                         DrawReal(vloc / scale, 5, 2);
  1560.                         DrawString(units);
  1561.                         DrawString(' (');
  1562.                         DrawReal(vloc, 3, 0);
  1563.                         DrawString(')')
  1564.                     end
  1565.                 else
  1566.                     DrawLong(vloc);
  1567.                 DrawString('    ');
  1568.                 MoveTo(zValueLoc, vstart + 20);
  1569.                 if Calibrated then begin
  1570.                         DrawReal(value[ivalue], 5, 2);
  1571.                         DrawString(' (');
  1572.                         DrawLong(ivalue);
  1573.                         DrawString(')');
  1574.                     end
  1575.                 else
  1576.                     DrawLong(ivalue);
  1577.                 DrawString('    ');
  1578.                 SetPort(tPort);
  1579.             end;
  1580.     end;
  1581.  
  1582.  
  1583.     procedure Show3RealValues;{(X,Y:LongInt; Z:extended)}
  1584.         var
  1585.             tPort: GrafPtr;
  1586.             hstart, vstart, ivalue: integer;
  1587.     begin
  1588.         hstart := ValuesHStart;
  1589.         vstart := ValuesVStart;
  1590.         GetPort(tPort);
  1591.         SetPort(ResultsWindow);
  1592.         TextSize(9);
  1593.         TextFont(Monaco);
  1594.         TextMode(SrcCopy);
  1595.         MoveTo(xValueLoc, vstart);
  1596.         DrawLong(x);
  1597.         DrawString('   ');
  1598.         MoveTo(yValueLoc, vstart + 10);
  1599.         DrawLong(y);
  1600.         DrawString('   ');
  1601.         MoveTo(zValueLoc, vstart + 20);
  1602.         DrawReal(z, 1, 2);
  1603.         DrawString('    ');
  1604.         SetPort(tPort);
  1605.     end;
  1606.  
  1607.  
  1608.     procedure PutChar;{(c:char)}
  1609.     begin
  1610.         if TextBufSize < MaxTextBufSize then begin
  1611.                 TextBufSize := TextBufSize + 1;
  1612.                 TextBufP^[TextBufSize] := c;
  1613.                 if c = return then begin
  1614.                         TextBufColumn := 0;
  1615.                         TextBufLineCount := TextBufLineCount + 1
  1616.                     end
  1617.                 else
  1618.                     TextBufColumn := TextBufColumn + 1;
  1619.             end;
  1620.     end;
  1621.  
  1622.  
  1623.     procedure PutTab;
  1624.         var
  1625.             i: integer;
  1626.     begin
  1627.         if not printing then
  1628.             PutChar(tab)
  1629.         else begin
  1630.                 for i := 1 to TabSpacing - TextBufColumn mod TabSpacing do
  1631.                     PutChar(' ');
  1632.             end;
  1633.     end;
  1634.  
  1635.  
  1636.     procedure PutString;{(str:str255)}
  1637.         var
  1638.             i: integer;
  1639.     begin
  1640.         for i := 1 to length(str) do begin
  1641.                 if TextBufSize < MaxTextBufSize then
  1642.                     TextBufSize := TextBufSize + 1;
  1643.                 TextBufP^[TextBufSize] := str[i];
  1644.                 TextBufColumn := TextBufColumn + 1;
  1645.             end;
  1646.     end;
  1647.  
  1648.  
  1649.     procedure PutReal;{(n:extended; width,fwidth:integer)}
  1650.         var
  1651.             str: str255;
  1652.     begin
  1653.         RealToString(n, width, fwidth, str);
  1654.         PutString(str);
  1655.     end;
  1656.  
  1657.  
  1658.     procedure PutLong;{(n:LongInt; FieldWidth:integer)}
  1659.         var
  1660.             str: str255;
  1661.             LeadingSpaces: integer;
  1662.     begin
  1663.         NumToString(n, str);
  1664.         LeadingSpaces := FieldWidth - length(str);
  1665.         if printing and (LeadingSpaces > 0) then
  1666.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1667.         PutString(str);
  1668.     end;
  1669.  
  1670.     procedure CopyResultsToBuffer;
  1671.         var
  1672.             i, column, nColumns: integer;
  1673.             TypeOfResults: ResultsType;
  1674.             m: MeasurementTypes;
  1675.  
  1676.         procedure PutSequenceNumber;
  1677.         begin
  1678.             PutLong(i, 8);
  1679.             PutChar('.');
  1680.             PutTab;
  1681.         end;
  1682.  
  1683.         procedure PutUnits;
  1684.         begin
  1685.             if info^.scale <> 0.0 then begin
  1686.                     PutString('(');
  1687.                     PutString(info^.Units);
  1688.                     PutString(')')
  1689.                 end
  1690.             else
  1691.                 PutString('(Pixels)');
  1692.             PutChar(return);
  1693.             PutChar(return);
  1694.         end;
  1695.  
  1696.         procedure PutTabDelimeter;
  1697.         begin
  1698.             Column := Column + 1;
  1699.             if Column <> nColumns then
  1700.                 PutTab;
  1701.         end;
  1702.  
  1703.     begin
  1704.         TypeOfResults := GetResultsType;
  1705.         if TypeOfResults <> NoResults then begin
  1706.                 TextBufSize := 0;
  1707.                 TextBufColumn := 0;
  1708.                 TextBufLineCount := 0;
  1709.                 case TypeOfResults of
  1710.                     LengthT: 
  1711.                         begin
  1712.                             if printing then begin
  1713.                                     PutTab;
  1714.                                     PutString(' Length');
  1715.                                     PutUnits;
  1716.                                 end;
  1717.                             for i := 1 to nLengths do begin
  1718.                                     if printing then
  1719.                                         PutSequenceNumber;
  1720.                                     PutReal(lengths[i], 9, 3);
  1721.                                     PutChar(return);
  1722.                                 end;
  1723.                             if not ShowingLIst then
  1724.                                 UnsavedLengths := 0;
  1725.                         end;
  1726.                     AreaT: 
  1727.                         with info^ do begin
  1728.                                 nMeasurements := 0;
  1729.                                 if printing then begin
  1730.                                         PutTab;
  1731.                                         if AreaM in measurements then begin
  1732.                                                 PutString('       Area');
  1733.                                                 PutTab;
  1734.                                                 nMeasurements := nMeasurements + 1
  1735.                                             end;
  1736.                                         if MeanM in measurements then begin
  1737.                                                 PutString('       Mean');
  1738.                                                 PutTab;
  1739.                                                 nMeasurements := nMeasurements + 1
  1740.                                             end;
  1741.                                         if StdDevM in measurements then begin
  1742.                                                 PutString('       S.D.');
  1743.                                                 PutTab;
  1744.                                                 nMeasurements := nMeasurements + 1
  1745.                                             end;
  1746.                                         if xyLocM in measurements then begin
  1747.                                                 PutString('         X');
  1748.                                                 PutTab;
  1749.                                                 PutString('         Y');
  1750.                                                 PutTab;
  1751.                                                 nMeasurements := nMeasurements + 2
  1752.                                             end;
  1753.                                         if ModeM in measurements then begin
  1754.                                                 PutString('       Mode');
  1755.                                                 PutTab;
  1756.                                                 nMeasurements := nMeasurements + 1
  1757.                                             end;
  1758.                                         if PerimeterM in measurements then begin
  1759.                                                 PutString('   P.Length');
  1760.                                                 PutTab;
  1761.                                                 nMeasurements := nMeasurements + 1
  1762.                                             end;
  1763.                                         if IntDenM in measurements then begin
  1764.                                                 PutString('   Int.Den.');
  1765.                                                 PutTab;
  1766.                                                 nMeasurements := nMeasurements + 1
  1767.                                             end;
  1768.                                         PutChar(return);
  1769.                                         PutChar(return);
  1770.                                     end;
  1771.                                 nColumns := 0;
  1772.                                 for m := AreaM to IntDenM do
  1773.                                     if m in Measurements then
  1774.                                         nColumns := nColumns + 1;
  1775.                                 for i := 1 to nAreas do begin
  1776.                                         column := 0;
  1777.                                         if printing then
  1778.                                             PutSequenceNumber;
  1779.                                         if AreaM in measurements then begin
  1780.                                                 if scale <> 0.0 then
  1781.                                                     PutReal(PixelCount[i] / sqr(scale), 11, 3)
  1782.                                                 else
  1783.                                                     PutLong(PixelCount[i], 11);
  1784.                                                 PutTabDelimeter;
  1785.                                             end;
  1786.                                         if MeanM in measurements then begin
  1787.                                                 PutReal(mean[i], 11, 3);
  1788.                                                 PutTabDelimeter;
  1789.                                             end;
  1790.                                         if StdDevM in measurements then begin
  1791.                                                 PutReal(SD[i], 11, 3);
  1792.                                                 PutTabDelimeter;
  1793.                                             end;
  1794.                                         if xyLocM in measurements then begin
  1795.                                                 PutReal(xcenter[i], 11, 3);
  1796.                                                 PutTab;
  1797.                                                 PutReal(ycenter[i], 11, 3);
  1798.                                                 PutTabDelimeter;
  1799.                                             end;
  1800.                                         if ModeM in measurements then begin
  1801.                                                 PutReal(Mode[i], 11, 3);
  1802.                                                 PutTabDelimeter;
  1803.                                             end;
  1804.                                         if PerimeterM in measurements then begin
  1805.                                                 PutReal(plength[i], 11, 3);
  1806.                                                 PutTabDelimeter;
  1807.                                             end;
  1808.                                         if IntDenM in measurements then begin
  1809.                                                 PutReal(IntegratedDensity[i], 11, 3);
  1810.                                                 PutTabDelimeter;
  1811.                                             end;
  1812.                                         PutChar(return);
  1813.                                     end;
  1814.                                 if not ShowingLIst then
  1815.                                     UnsavedAreas := 0;
  1816.                             end;
  1817.                     PointT: 
  1818.                         begin
  1819.                             if printing then begin
  1820.                                     PutTab;
  1821.                                     PutString('      X');
  1822.                                     PutTab;
  1823.                                     PutString('      Y  ');
  1824.                                     PutUnits;
  1825.                                 end;
  1826.                             for i := 1 to nPoints do
  1827.                                 with info^ do begin
  1828.                                         if printing then
  1829.                                             PutSequenceNumber;
  1830.                                         if scale = 0.0 then begin
  1831.                                                 PutLong(xLoc[i], 7);
  1832.                                                 PutTab;
  1833.                                                 PutLong(yLoc[i], 7);
  1834.                                             end
  1835.                                         else begin
  1836.                                                 PutReal(xLoc[i] / scale, 9, 3);
  1837.                                                 PutTab;
  1838.                                                 PutReal(yLoc[i] / scale, 9, 3);
  1839.                                             end;
  1840.                                         PutChar(return);
  1841.                                     end;
  1842.                             if not ShowingLIst then
  1843.                                 UnsavedPoints := 0;
  1844.                         end;
  1845.                     otherwise
  1846.                         ;
  1847.                 end; {case}
  1848.             end;
  1849.     end;
  1850.  
  1851.  
  1852.     function GetResultsType;{:ResultsType}
  1853.     begin
  1854.         if (CurrentTool = ruler) and (nLengths > 0) then
  1855.             GetResultsType := LengthT
  1856.         else if (CurrentTool = PointingTool) and (nPoints > 0) then
  1857.             GetResultsType := PointT
  1858.         else if nAreas > 0 then
  1859.             GetResultsType := AreaT
  1860.         else
  1861.             GetResultsType := NoResults;
  1862.     end;
  1863.  
  1864.  
  1865.     procedure ShowWatch;
  1866.     begin
  1867.         SetCursor(watch^^);
  1868.     end;
  1869.  
  1870.  
  1871.     procedure UpdatePicWindow;
  1872.         var
  1873.             tPort: GrafPtr;
  1874.     begin
  1875.         with Info^ do begin
  1876.                 getPort(tPort);
  1877.                 SetPort(wptr);
  1878.                 hlock(handle(osPort^.portPixMap));
  1879.                 hlock(handle(CGrafPort(ThePort^).PortPixMap));
  1880.                 CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, SrcRect, wrect, SrcCopy, nil);
  1881.                 hunlock(handle(osPort^.portPixMap));
  1882.                 hunlock(handle(CGrafPort(ThePort^).PortPixMap));
  1883.                 SetPort(tPort);
  1884.             end;
  1885.     end;
  1886.  
  1887.  
  1888.     procedure DoOperation;{(Operation:OpType)}
  1889.         var
  1890.             tPort: GrafPtr;
  1891.             loc: point;
  1892.             width, height: integer;
  1893.             tRect: rect;
  1894.     begin
  1895.         GetPort(tPort);
  1896.         with Info^ do begin
  1897.                 changes := true;
  1898.                 SetPort(GrafPtr(osPort));
  1899.                 PenNormal;
  1900.                 PenSize(LineWidth, LineWidth);
  1901.                 case Operation of
  1902.                     InvertOp: 
  1903.                         InvertRgn(osroiRgn);
  1904.                     PaintOp: 
  1905.                         PaintRgn(osroiRgn);
  1906.                     FrameOp: 
  1907.                         FrameRgn(osroiRgn);
  1908.                     EraseOp: 
  1909.                         EraseRgn(osroiRgn);
  1910.                     PasteOp: 
  1911.                         Paste;
  1912.                     otherwise
  1913.                 end;
  1914.                 if not RoiShowing then
  1915.                     UpdateScreen(RoiRect);
  1916.                 if PicSize > UndoBufSize then
  1917.                     OpPending := false;
  1918.             end;
  1919.         SetPort(tPort);
  1920.     end;
  1921.  
  1922.  
  1923.     procedure SaveRoi;
  1924.     begin
  1925.         with info^ do
  1926.             if RoiType <> noRoi then begin
  1927.                     NoInfo^.roiType := roiType;
  1928.                     NoInfo^.roiRect := RoiRect;
  1929.                     NoInfo^.osRoiRect := osRoiRect;
  1930.                     CopyRgn(osRoiRgn, NoInfo^.osRoiRgn);
  1931.                 end;
  1932.     end;
  1933.  
  1934.  
  1935.     procedure KillRoi;
  1936.     begin
  1937.         with info^ do begin
  1938.                 if RoiShowing then begin
  1939.                         if OpPending then begin
  1940.                                 OpPending := false;
  1941.                                 DoOperation(CurrentOp);
  1942.                             end;
  1943.                         SaveRoi;
  1944.                         RoiShowing := false;
  1945.                         UpdateScreen(RoiRect);
  1946.                     end;
  1947.                 RoiType := NoRoi;
  1948.             end;
  1949.     end;
  1950.  
  1951.  
  1952.     procedure Paste;
  1953.         var
  1954.             SourceInfo: InfoPtr;
  1955.     begin
  1956.         if info = NoInfo then begin
  1957.                 beep;
  1958.                 exit(Paste)
  1959.             end;
  1960.         with Info^ do begin
  1961.                 if not RoiShowing then
  1962.                     exit(Paste);
  1963.                 if PasteTransferMode = SrcCopy then begin
  1964.                         osPort^.fgColor := BlackC;
  1965.                         osPort^.bkColor := WhiteC;
  1966.                     end;
  1967.                 SourceInfo := ClipBufInfo;
  1968.                 if PasteMode = PasteFromCamera then
  1969.                     if (CameraInfo = nil) or (PictureType = Camera) then
  1970.                         PasteMode := NormalPaste
  1971.                     else begin
  1972.                             ControlReg^ := BitAnd($80, 255); {Start frame capture}
  1973.                             while ControlReg^ < 0 do
  1974.                                 ;       {Wait for it to complete}
  1975.                             SourceInfo := CameraInfo;
  1976.                         end;
  1977.                 hlock(handle(SourceInfo^.osPort^.portPixMap));
  1978.                 hlock(handle(osPort^.portPixMap));
  1979.                 CopyBits(BitMapHandle(SourceInfo^.osPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.osRoiRect, osRoiRect, PasteTransferMode, osRoiRgn);
  1980.                 hunlock(handle(SourceInfo^.osPort^.portPixMap));
  1981.                 hunlock(handle(osPort^.PortPixMap));
  1982.                 osPort^.fgColor := ForegroundColor;
  1983.                 osPort^.bkColor := BackgroundColor;
  1984.             end;
  1985.     end;
  1986.  
  1987.  
  1988.     procedure ShowRoi;
  1989.     begin
  1990.         with info^ do
  1991.             if RoiType <> NoRoi then begin
  1992.                     SetupUndo;
  1993.                     RoiShowing := true;
  1994.                     RoiRect := osroiRect;
  1995.                     OffscreenToScreenRect(RoiRect);
  1996.                 end;
  1997.     end;
  1998.  
  1999.  
  2000.     procedure SetupUndo;
  2001.         var
  2002.             src, dst: ptr;
  2003.             line: integer;
  2004.     begin
  2005.         if info = NoInfo then begin
  2006.                 CurrentUndoSize := 0;
  2007.                 exit(SetupUndo)
  2008.             end;
  2009.         if info^.PicSize > UndoBufSize then begin
  2010.                 CurrentUndoSize := 0;
  2011.                 WhatToUndo := NothingToUndo;
  2012.                 exit(SetupUndo)
  2013.             end;
  2014.         with info^ do begin
  2015.                 if OpPending then begin
  2016.                         DoOperation(CurrentOp);
  2017.                         OpPending := false;
  2018.                     end;
  2019.                 CurrentUndoSize := PicSize;
  2020.                 if PictureType = camera then begin
  2021.                         src := PicBaseAddr;
  2022.                         dst := UndoBuf;
  2023.                         for line := 1 to 480 do begin
  2024.                                 BlockMove(src, dst, 640);
  2025.                                 src := ptr(ord4(src) + 1024);
  2026.                                 dst := ptr(ord4(dst) + 640);
  2027.                             end;
  2028.                     end
  2029.                 else
  2030.                     BlockMove(PicBaseAddr, UndoBuf, PicSize);
  2031.             end;
  2032.         UndoFromClip := false;
  2033.         RedoSelection := false;
  2034.     end;
  2035.  
  2036.  
  2037.     procedure SetupUndoFromClip;
  2038.         var
  2039.             src, dst: ptr;
  2040.             line: integer;
  2041.     begin
  2042.         if info = NoInfo then begin
  2043.                 CurrentUndoSize := 0;
  2044.                 WhatToUndo := NothingToUndo;
  2045.                 exit(SetupUndoFromClip)
  2046.             end;
  2047.         if info^.PicSize > ClipBufSize then begin
  2048.                 CurrentUndoSize := 0;
  2049.                 WhatToUndo := NothingToUndo;
  2050.                 exit(SetupUndoFromClip)
  2051.             end;
  2052.         with info^ do begin
  2053.                 if OpPending then begin
  2054.                         DoOperation(CurrentOp);
  2055.                         OpPending := false;
  2056.                     end;
  2057.                 CurrentUndoSize := PicSize;
  2058.                 if PictureType = camera then begin
  2059.                         src := PicBaseAddr;
  2060.                         dst := ClipBuf;
  2061.                         for line := 1 to 480 do begin
  2062.                                 BlockMove(src, dst, 640);
  2063.                                 src := ptr(ord4(src) + 1024);
  2064.                                 dst := ptr(ord4(dst) + 640);
  2065.                             end;
  2066.                     end
  2067.                 else
  2068.                     BlockMove(PicBaseAddr, ClipBuf, PicSize);
  2069.             end;
  2070.         WhatsOnClip := nothing;
  2071.         UndofromClip := true;
  2072.         RedoSelection := false;
  2073.     end;
  2074.  
  2075.  
  2076.     procedure DrawLabels;
  2077.         var
  2078.             tPort: GrafPtr;
  2079.             trect: rect;
  2080.             hstart, vstart, ivalue: integer;
  2081.     begin
  2082.         hstart := ValuesHStart;
  2083.         vstart := ValuesVStart;
  2084.         GetPort(tPort);
  2085.         SetPort(ResultsWindow);
  2086.         TextSize(9);
  2087.         TextFont(Monaco);
  2088.         TextFace([bold]);
  2089.         Setrect(trect, 0, 0, 140, 32);
  2090.         EraseRect(trect);
  2091.         MoveTo(hstart, vstart);
  2092.         case ValuesMode of
  2093.             PixelValues: 
  2094.                 begin
  2095.                     DrawString('X:');
  2096.                     xValueLoc := 20
  2097.                 end;
  2098.             IndexValue: 
  2099.                 begin
  2100.                     DrawString('Value:');
  2101.                     xValueLoc := 46
  2102.                 end;
  2103.             AngleValue: 
  2104.                 begin
  2105.                     DrawString('Angle:');
  2106.                     xValueLoc := 48
  2107.                 end;
  2108.             CountValues: 
  2109.                 begin
  2110.                     DrawString('Current:');
  2111.                     xValueLoc := 60
  2112.                 end;
  2113.             WidthValues: 
  2114.                 begin
  2115.                     DrawString('Width:');
  2116.                     xValueLoc := 54
  2117.                 end;
  2118.             LengthValues: 
  2119.                 begin
  2120.                     DrawString('X:');
  2121.                     xValueLoc := 20
  2122.                 end;
  2123.             xyValues: 
  2124.                 begin
  2125.                     DrawString('X:');
  2126.                     xValueLoc := 18
  2127.                 end;
  2128.             otherwise
  2129.         end;
  2130.         MoveTo(hstart, vstart + 10);
  2131.         case ValuesMode of
  2132.             PixelValues: 
  2133.                 begin
  2134.                     DrawString('Y:');
  2135.                     yValueLoc := 20
  2136.                 end;
  2137.             CountValues: 
  2138.                 begin
  2139.                     DrawString('Total:');
  2140.                     yValueLoc := 46
  2141.                 end;
  2142.             WidthValues: 
  2143.                 begin
  2144.                     DrawString('Height:');
  2145.                     yValueLoc := 54
  2146.                 end;
  2147.             LengthValues: 
  2148.                 begin
  2149.                     DrawString('Y:');
  2150.                     yValueLoc := 20
  2151.                 end;
  2152.             xyValues: 
  2153.                 begin
  2154.                     DrawString('Y:');
  2155.                     yValueLoc := 18
  2156.                 end;
  2157.             otherwise
  2158.         end;
  2159.         MoveTo(hstart, vstart + 20);
  2160.         case ValuesMode of
  2161.             PixelValues: 
  2162.                 begin
  2163.                     DrawString('Value:');
  2164.                     zValueLoc := 46
  2165.                 end;
  2166.             LengthValues: 
  2167.                 begin
  2168.                     DrawString('Length:');
  2169.                     zValueLoc := 52
  2170.                 end;
  2171.             otherwise
  2172.         end;
  2173.         TextFace([]);
  2174.         SetPort(tPort);
  2175.     end;
  2176.  
  2177.  
  2178.     function NoSelection;{:boolean}
  2179.     begin
  2180.         if Info = NoInfo then begin
  2181.                 beep;
  2182.                 NoSelection := true;
  2183.                 exit(NoSelection);
  2184.             end;
  2185.         if not Info^.RoiShowing then
  2186.             PutMessage('Please use the Selection Tool to make a selection ', 'or use the    Select All command.', '');
  2187.         NoSelection := not Info^.RoiShowing;
  2188.     end;
  2189.  
  2190.  
  2191.     function NotRectangular;{:boolean}
  2192.     begin
  2193.         with info^ do
  2194.             if RoiShowing and (RoiType <> RectRoi) then begin
  2195.                     PutMessage('This function requires a rectangular selection.', '', '');
  2196.                     NotRectangular := true;
  2197.                 end
  2198.             else
  2199.                 NotRectangular := false;
  2200.     end;
  2201.  
  2202.  
  2203.     function NotInBounds;{:boolean}
  2204.     begin
  2205.         NotInBounds := false;
  2206.         with info^, info^.osroiRect do
  2207.             if RoiShowing then
  2208.                 if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
  2209.                         PutMessage('This function requires the selection to be entirely within the picture.', '', '');
  2210.                         NotInBounds := true;
  2211.                     end;
  2212.     end;
  2213.  
  2214.  
  2215.  
  2216.     procedure PutOutOfMemMsg;
  2217.     begin
  2218.         PutMessage('Sorry, but there is not enough memory available to open this picture.', ' Try closing some windows.', '');
  2219.     end;
  2220.  
  2221.  
  2222.     function GetMemory;{(Size:LongInt):ptr}
  2223.         var
  2224.             p: ptr;
  2225.             free: LongInt;
  2226.     begin
  2227.         p := NewPtr(Size);
  2228.         if p <> nil then
  2229.             free := CompactMem(1000000)
  2230.         else
  2231.             free := 0;
  2232.         if (p <> nil) and (free > 50000) then
  2233.             GetMemory := p
  2234.         else begin
  2235.                 GetMemory := nil;
  2236.                 if p <> nil then
  2237.                     DisposPtr(p);
  2238.                 DisposPtr(pointer(Info));
  2239.                 Info := SaveInfo;
  2240.                 LoadLUT(info^.cTable);
  2241.                 PutOutOfMemMsg;
  2242.             end;
  2243.     end;
  2244.  
  2245.  
  2246.     procedure UpdateAnalysisMenu;
  2247.         var
  2248.             ShowItems: boolean;
  2249.             i: integer;
  2250.     begin
  2251.         ShowItems := Info <> NoInfo;
  2252.         SetMenuItem(AnalysisMenuH, MeasureItem, ShowItems);
  2253.         SetMenuItem(AnalysisMenuH, HistogramItem, ShowItems);
  2254.         SetMenuItem(AnalysisMenuH, PlotItem, ShowItems);
  2255.         SetMenuItem(AnalysisMenuH, Plot3DItem, ShowItems);
  2256.         SetMenuItem(AnalysisMenuH, SaveBlankFieldItem, ShowItems);
  2257.         SetMenuItem(AnalysisMenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
  2258.         SetMenuItem(AnalysisMenuH, NumberSelectionItem, info^.RoiShowing);
  2259.     end;
  2260.  
  2261.  
  2262.     procedure UpdateWindowsMenu;{(fname:str255; size:LongInt; wptr:WindowPtr)}
  2263.         var
  2264.             str, SizeStr: str255;
  2265.     begin
  2266.         if nPics < MaxPics then begin
  2267.                 nPics := nPics + 1;
  2268.                 PicWindow[nPics] := wptr;
  2269.             end;
  2270.         if nPics <= MaxPicsInMenu then begin
  2271.                 NumToString(size div 1024, SizeStr);
  2272.                 str := concat(fname, '  ', SizeStr, 'K');
  2273.                 AppendMenu(WindowsMenuH, ' ');
  2274.                 SetItem(WindowsMenuH, nPics + nItems, str);
  2275.                 InsertMenu(WindowsMenuH, 0);
  2276.             end;
  2277.     end;
  2278.  
  2279.  
  2280.     procedure MakeNewWindow;{(name:str255)}
  2281.         var
  2282.             wwidth, wheight, wleft, wtop, i: integer;
  2283.             tPort: GrafPtr;
  2284.             rgb: RGBColor;
  2285.             err: OSErr;
  2286.     begin
  2287.         with Info^ do begin
  2288.                 wleft := PicWindowLeft;
  2289.                 wtop := PicWindowTop;
  2290.                 wwidth := PixelsPerLine;
  2291.                 if (wleft + wwidth) > ScreenWidth then
  2292.                     wwidth := ScreenWidth - wleft - 5;
  2293.                 wheight := nlines;
  2294.                 if (wtop + wheight) > ScreenHeight then
  2295.                     wheight := ScreenHeight - wtop - 5;
  2296.                 SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
  2297.                 wptr := NewCWindow(nil, wrect, name, true, DocumentProc + ZoomDocProc, nil, true, 0);
  2298.                 SetRect(wrect, 0, 0, wwidth, wheight);
  2299.                 SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
  2300.                 SelectWindow(wptr);
  2301.                 WindowPeek(wptr)^.WindowKind := PicKind;
  2302.                 WindowPeek(wptr)^.RefCon := ord4(Info);
  2303.                 title := name;
  2304.                 UpdateWindowsMenu(name, PicSize, wptr);
  2305.                 PicNum := nPics;
  2306.                 GetPort(tPort);
  2307.                 new(osPort);
  2308.                 OpenCPort(osPort);
  2309.                 with osPort^ do begin
  2310.                         with PortPixMap^^ do begin
  2311.                                 BaseAddr := PicBaseAddr;
  2312.                                 bounds := PicRect;
  2313.                             end;
  2314.                         PortRect := PicRect;
  2315.                         RectRgn(visRgn, PicRect);
  2316.                         if PictureType = Camera then begin
  2317.                                 PortPixMap^^.RowBytes := BitOr(1024, $8000);
  2318.                                 BytesPerRow := 1024;
  2319.                                 PixMapSize := LongInt(nLines) * 1024;
  2320.                             end
  2321.                         else begin
  2322.                                 PortPixMap^^.RowBytes := BitOr(PixelsPerLine, $8000);
  2323.                                 BytesPerRow := PixelsPerLine;
  2324.                                 PixMapSize := PicSize
  2325.                             end;
  2326.                     end;
  2327.                 SetPort(tPort);
  2328.                 SrcRect := wrect;
  2329.                 magnification := 1.0;
  2330.                 RoiShowing := false;
  2331.                 roiType := NoRoi;
  2332.                 savewrect := wrect;
  2333.                 osroiRgn := NewRgn;
  2334.                 NewPic := true;
  2335.                 osPort^.fgColor := ForegroundColor;
  2336.                 osPort^.bkColor := BackgroundColor;
  2337.                 ScaleToFitWindow := false;
  2338.                 OpPending := false;
  2339.                 Changes := false;
  2340.             end;
  2341.         WhatToUndo := NothingToUndo;
  2342.     end;
  2343.  
  2344.  
  2345.     procedure MakeRegion;
  2346.     begin
  2347.         with info^ do begin
  2348.                 PenNormal;
  2349.                 OpenRgn;
  2350.                 case RoiType of
  2351.                     OvalRoi: 
  2352.                         FrameOval(osroiRect);
  2353.                     RoundRectRoi: 
  2354.                         FrameRoundRect(osRoiRect, OvalSize, OvalSize);
  2355.                     RectRoi: 
  2356.                         FrameRect(osRoiRect);
  2357.                     otherwise
  2358.                 end;
  2359.                 CloseRgn(osroiRgn)
  2360.             end;
  2361.     end;
  2362.  
  2363.  
  2364.     procedure SelectAll;{(visible:boolean)}
  2365.         var
  2366.             loc: point;
  2367.             tPort: GrafPtr;
  2368.     begin
  2369.         if Info = NoInfo then begin
  2370.                 beep;
  2371.                 exit(SelectAll)
  2372.             end;
  2373.         KillRoi;
  2374.         with Info^ do begin
  2375.                 RoiType := RectRoi;
  2376.                 osroiRect := PicRect;
  2377.                 roiRect := PicRect;
  2378.                 OffscreenToScreenRect(roiRect);
  2379.                 MakeRegion;
  2380.                 if visible then begin
  2381.                         SetupUndo;
  2382.                         WhatToUndo := NothingToUndo;
  2383.                         RoiShowing := true;
  2384.                         if (magnification > 1.0) and not ScaleToFitWindow then
  2385.                             Unzoom;
  2386.                         PreviousTool := CurrentTool;
  2387.                         CurrentTool := SelectionTool;
  2388.                         GetPort(tPort);
  2389.                         SetPort(ToolWindow);
  2390.                         EraseRect(ToolRect[PreviousTool]);
  2391.                         EraseRect(ToolRect[CurrentTool]);
  2392.                         InvalRect(ToolRect[PreviousTool]);
  2393.                         InvalRect(ToolRect[CurrentTool]);
  2394.                         SetPort(tPort);
  2395.                     end;
  2396.                 IsInsertionPoint := false;
  2397.                 measuring := false;
  2398.             end; {with}
  2399.     end;
  2400.  
  2401.  
  2402.     procedure KillOperation;
  2403.     begin
  2404.         if OpPending then
  2405.             with info^ do
  2406.                 if info <> NoInfo then begin
  2407.                         DoOperation(CurrentOp);
  2408.                         RoiShowing := false;
  2409.                         UpdateScreen(RoiRect);
  2410.                         OpPending := false;
  2411.                     end;
  2412.     end;
  2413.  
  2414.  
  2415.     function NewPicWindow;{(name:str255; width,height:integer):boolean}
  2416.         var
  2417.             iptr: ptr;
  2418.             lptr: ^LongInt;
  2419.     begin
  2420.         NewPicWindow := false;
  2421.         KillOperation;
  2422.         StopThresholding;
  2423.         SaveInfo := Info;
  2424.         iptr := NewPtr(SizeOf(PicInfo));
  2425.         if iptr = nil then begin
  2426.                 PutOutOfMemMsg;
  2427.                 DisposPtr(iptr);
  2428.                 exit(NewPicWindow);
  2429.             end;
  2430.         Info := pointer(iptr);
  2431.         info^ := SaveInfo^;
  2432.         with Info^ do begin
  2433.                 nlines := height;
  2434.                 PixelsPerLine := width;
  2435.                 PicSize := LongInt(nlines) * PixelsPerLine;
  2436.                 if name = 'Camera' then begin
  2437.                         PicBaseAddr := ptr(DTSlotBase);
  2438.                         PictureType := Camera;
  2439.                         CameraInfo := info;
  2440.                     end
  2441.                 else begin
  2442.                         PicBaseAddr := Getmemory(PicSize);
  2443.                         PictureType := NewPicture;
  2444.                         if PicBaseAddr = nil then
  2445.                             exit(NewPicWindow);
  2446.                     end;
  2447.                 MakeNewWindow(name);
  2448.                 if name <> 'Camera' then begin
  2449.                         SelectAll(false);
  2450.                         DoOperation(EraseOp);
  2451.                         RoiType := NoRoi;
  2452.                     end;
  2453.                 changes := false;
  2454.                 BinaryPic := false;
  2455.             end;
  2456.         NewPicWindow := true;
  2457.     end;
  2458.  
  2459.  
  2460.     procedure EraseScreen;
  2461.         var
  2462.             SaveBkColor: integer;
  2463.     begin
  2464.         SetPort(GrafPtr(CScreenPort));
  2465.         with CScreenPort^ do begin
  2466.                 HideCursor;
  2467.                 SaveBkColor := bkColor;
  2468.                 bkColor := BackgroundColor;
  2469.                 EraseRect(portPixMap^^.Bounds);
  2470.                 bkColor := saveBkColor;
  2471.             end;
  2472.     end;
  2473.  
  2474.  
  2475.     procedure RestoreScreen;
  2476.         var
  2477.             GrayRgn: RgnHandle;
  2478.             rptr: rhptr;
  2479.             wp: ^WindowPtr;
  2480.     begin
  2481.         rptr := rhptr(GrayRgnGlobal);
  2482.         GrayRgn := rptr^;
  2483.         wp := pointer(GhostWindow);
  2484.         wp^ := WindowPtr(nil);
  2485.         PaintBehind(WindowPeek(FrontWindow), GrayRgn);
  2486.         wp^ := ToolWindow;
  2487.         DrawMenuBar;
  2488.     end;
  2489.  
  2490.  
  2491.     procedure ScaleToFit;
  2492.     begin
  2493.         if info <> NoInfo then
  2494.             with info^ do begin
  2495.                     ScaleToFitWindow := not ScaleToFitWindow;
  2496.                     KillRoi;
  2497.                     if ScaleToFitWindow then begin
  2498.                             wrect := wptr^.PortRect;
  2499.                             SrcRect := PicRect;
  2500.                         end
  2501.                     else begin
  2502.                             wrect := savewrect;
  2503.                             SrcRect := savewrect
  2504.                         end;
  2505.                     magnification := 1.0;
  2506.                     SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2507.                     InvalRect(wrect);
  2508.                 end;
  2509.     end;
  2510.  
  2511.  
  2512.     procedure DrawMyGrowIcon;{(w:WindowPtr)}
  2513.         var
  2514.             tPort: GrafPtr;
  2515.             tRect: rect;
  2516.     begin
  2517.         GetPort(tPort);
  2518.         SetPort(w);
  2519.         PenNormal;
  2520.         with w^.PortRect do begin
  2521.                 SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
  2522.                 FrameRect(tRect);
  2523.                 MoveTo(right - 6, bottom - 10);
  2524.                 LineTo(right - 2, bottom - 10);
  2525.                 LineTo(right - 2, bottom - 2);
  2526.                 LineTo(right - 10, bottom - 2);
  2527.                 LineTo(right - 10, bottom - 6);
  2528.             end;
  2529.         SetPort(tPort);
  2530.     end;
  2531.  
  2532.  
  2533.     procedure Unzoom;
  2534.     begin
  2535.         if Info <> NoInfo then
  2536.             with Info^ do begin
  2537.                     if ScaleToFitWindow then
  2538.                         ScaleToFit
  2539.                     else begin
  2540.                             wrect := savewrect;
  2541.                             SrcRect := wrect;
  2542.                         end;
  2543.                     SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2544.                     LoadLUT(info^.cTable);
  2545.                     UpdatePicWindow;
  2546.                     magnification := 1.0;
  2547.                     DrawMyGrowIcon(wptr);
  2548.                     if WhatToUndo = UndoZoom then
  2549.                         WhatToUndo := NothingToUndo;
  2550.                     ShowRoi;
  2551.                 end;
  2552.     end;
  2553.  
  2554.  
  2555.     function FindMedian;{(VAR a:SortArray):integer}
  2556.   {Finds the 5th largest of 9 values}
  2557.         var
  2558.             i, j, mj, max: integer;
  2559.     begin
  2560.         for i := 1 to 4 do begin
  2561.                 max := 0;
  2562.                 mj := 1;
  2563.                 for j := 1 to 9 do
  2564.                     if a[j] > max then begin
  2565.                             max := a[j];
  2566.                             mj := j;
  2567.                         end;
  2568.                 a[mj] := 0;
  2569.             end;
  2570.         max := 0;
  2571.         for j := 1 to 9 do
  2572.             if a[j] > max then
  2573.                 max := a[j];
  2574.         FindMedian := max;
  2575.     end;
  2576.  
  2577.  
  2578.     procedure Duplicate;{(SavingBlankField:boolean)}
  2579.         var
  2580.             name: str255;
  2581.             width, height, hstart, vstart, i: integer;
  2582.             SaveInfo: InfoPtr;
  2583.             src, dst: ptr;
  2584.             offset: LongInt;
  2585.             AutoSelectAll: boolean;
  2586.     begin
  2587.         WhatToUndo := NothingToUndo;
  2588.         if (not SavingBlankField) and (NotRectangular or NotinBounds) then
  2589.             exit(Duplicate);
  2590.         AutoSelectAll := (not Info^.RoiShowing) or SavingBlankField;
  2591.         if AutoSelectAll then
  2592.             SelectAll(false);
  2593.         ShowWatch;
  2594.         with info^ do begin
  2595.                 if SavingBlankField then
  2596.                     name := 'Blank Field'
  2597.                 else begin
  2598.                         GetWTitle(wptr, name);
  2599.                         name := concat('Copy of ', name);
  2600.                     end;
  2601.                 with osroiRect do begin
  2602.                         width := right - left;
  2603.                         if odd(width) and (left + width < PicRect.right) then
  2604.                             width := Width + 1;
  2605.                         height := bottom - top;
  2606.                         hstart := left;
  2607.                         vstart := top;
  2608.                     end;
  2609.             end;
  2610.         if AutoSelectAll then
  2611.             KillRoi;
  2612.         SaveInfo := Info;
  2613.         if NewPicWindow(name, width, height) then
  2614.             with SaveInfo^ do begin
  2615.                     offset := LongInt(vstart) * BytesPerRow + hstart;
  2616.                     src := ptr(ord4(PicBaseAddr) + offset);
  2617.                     dst := Info^.PicBaseAddr;
  2618.                     for i := 0 to height - 1 do begin
  2619.                             BlockMove(src, dst, width);
  2620.                             src := ptr(ord4(src) + BytesPerRow);
  2621.                             dst := ptr(ord4(dst) + width);
  2622.                         end;
  2623.                     if SavingBlankField then begin
  2624.                             Info^.PIctureType := BlankField;
  2625.                             BlankFieldInfo := info;
  2626.                         end;
  2627.                 end;
  2628.     end;
  2629.  
  2630.  
  2631.     procedure InvertPic;
  2632.         var
  2633.             tPort: GrafPtr;
  2634.     begin
  2635.         GetPort(tPort);
  2636.         with Info^ do begin
  2637.                 SetPort(GrafPtr(osPort));
  2638.                 InvertRect(PicRect);
  2639.             end;
  2640.         SetPort(tPort);
  2641.     end;
  2642.  
  2643.  
  2644.     procedure DrawBString;{(str:string)}
  2645.     begin
  2646.         TextFace([bold]);
  2647.         DrawString(str);
  2648.         TextFace([]);
  2649.     end;
  2650.  
  2651.  
  2652.     procedure PutWarning;
  2653.         var
  2654.             BufSizeStr: str255;
  2655.     begin
  2656.         NumToString(UndoBufSize div 1024, BufSizeStr);
  2657.         PutMessage('This picture is larger than the ', BufSizeStr, 'K Undo buffer. Many operations may fail or be Undoable.');
  2658.     end;
  2659.  
  2660.  
  2661.  
  2662.     procedure SetupRoiRect;
  2663.     begin
  2664.         SetupUndo;
  2665.         UndoFromClip := true;
  2666.         info^.RoiShowing := true;
  2667.     end;
  2668.  
  2669.  
  2670.     procedure ConvertHistoToText;
  2671.         var
  2672.             i: integer;
  2673.     begin
  2674.         TextBufSize := 0;
  2675.         TextOnClip := true;
  2676.         for i := 0 to 255 do begin
  2677.                 PutLong(Histogram[i], 1);
  2678.                 if i <> 255 then
  2679.                     PutChar(return);
  2680.             end;
  2681.     end;
  2682.  
  2683.  
  2684.     procedure ConvertPlotToText;
  2685.         var
  2686.             i: integer;
  2687.     begin
  2688.         TextBufSize := 0;
  2689.         TextOnClip := true;
  2690.         for i := 0 to PlotCount - 1 do begin
  2691.                 if info^.calibrated then
  2692.                     PutReal(value[PlotData[i]], 1, 3)
  2693.                 else
  2694.                     PutLong(PlotData[i], 1);
  2695.                 if i <> PlotCount then
  2696.                     PutChar(return);
  2697.             end;
  2698.     end;
  2699.  
  2700.     procedure GetForegroundColor;{(event: EventRecord)}
  2701.         var
  2702.             loc: point;
  2703.             color: integer;
  2704.     begin
  2705.         loc := event.where;
  2706.         ScreenToOffScreen(loc);
  2707.         Color := MyGetPixel(loc.h, loc.v);
  2708.         SetForegroundColor(color);
  2709.     end;
  2710.  
  2711.  
  2712.     procedure GetBackgroundColor; {(event: EventRecord)}
  2713.         var
  2714.             loc: point;
  2715.             color: integer;
  2716.     begin
  2717.         loc := event.where;
  2718.         ScreenToOffScreen(loc);
  2719.         Color := MyGetPixel(loc.h, loc.v);
  2720.         SetBackgroundColor(color);
  2721.     end;
  2722.  
  2723.  
  2724.     procedure GenerateValues;
  2725.         var
  2726.             a, b, c, d, e, f, x, y: extended;
  2727.             i: integer;
  2728.     begin
  2729.         with info^ do begin
  2730.                 if not calibrated then begin
  2731.                         for i := 0 to 255 do
  2732.                             value[i] := i;
  2733.                         MinValue := 0.0;
  2734.                         MaxValue := 255.0;
  2735.                         exit(GenerateValues);
  2736.                     end;
  2737.                 a := Coefficient[1];
  2738.                 b := Coefficient[2];
  2739.                 c := Coefficient[3];
  2740.                 d := Coefficient[4];
  2741.                 e := Coefficient[5];
  2742.                 f := Coefficient[6];
  2743.                 MinValue := 10e+12;
  2744.                 MaxValue := -MinValue;
  2745.                 for i := 0 to 255 do begin
  2746.                         x := i;
  2747.                         case fit of
  2748.                             StrightLine: 
  2749.                                 y := a + b * x;
  2750.                             Poly2: 
  2751.                                 y := a + b * x + c * x * x;
  2752.                             Poly3: 
  2753.                                 y := a + b * x + c * x * x + d * x * x * x;
  2754.                             Poly4: 
  2755.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
  2756.                             Poly5: 
  2757.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
  2758.                             ExpoFit: 
  2759.                                 y := a * exp(b * x);
  2760.                             PowerFit: 
  2761.                                 if x = 0.0 then
  2762.                                     y := 0.0
  2763.                                 else
  2764.                                     y := a * exp(b * ln(x)); {y=ax^b}
  2765.                             LogFit: 
  2766.                                 begin
  2767.                                     if x = 0.0 then
  2768.                                         x := 0.000001;
  2769.                                     y := a * ln(b * x)
  2770.                                 end;
  2771.                         end;
  2772.                         value[i] := y;
  2773.                         if y > MaxValue then
  2774.                             MaxValue := y;
  2775.                         if y < MinValue then
  2776.                             MinValue := y;
  2777.                     end;
  2778.             end;
  2779.     end;
  2780.  
  2781.  
  2782. end.